home *** CD-ROM | disk | FTP | other *** search
/ SuperHack / SuperHack CD.bin / CODING / DEMOS / ACGSTRS.ZIP / STARS.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1995-08-24  |  5.4 KB  |  211 lines

  1. Program ParallaxScrolling; {My OWN try, after I know the basics!}
  2. Uses Crt,GFX3;
  3. Type PalT = Array [0..255,0..2] of Byte;
  4. Const
  5.      VgaAddr = $a000;
  6.      MaxStars = 50;
  7.      MaxLayers = 4;
  8. Var
  9.      Stars : Array [1..maxlayers,1..maxstars] of Array[0..1] of integer;
  10.      Pallete : PalT;
  11.      Ticks : Word;
  12.      i:Word;
  13.      ch:Char;
  14. {--------------------------------------------------------------------------}
  15. Procedure ClrVGA;
  16. var i : word;
  17. begin
  18.  for i := 0 to 64000 do
  19.  meml[$A000:i] := 0;
  20. end;
  21. {-------------------------------------------------------------------------}
  22. Procedure VideoMode ( Mode : Byte );
  23. Begin { VideoMode }
  24.  Asm
  25.   Mov  AH,00
  26.   Mov  AL,Mode
  27.   Int  10h
  28.  End;
  29. End;
  30. {-------------------------------------------------------------------------}
  31. Procedure Pal(Col, R, G, B : Byte);
  32. Begin
  33.    Asm
  34.       mov   dx, 3c8h
  35.       mov   al, [Col]
  36.       out   dx, al
  37.       inc   dx
  38.       mov   al, [R]
  39.       out   dx, al
  40.       mov   al, [G]
  41.       out   dx, al
  42.       mov   al, [B]
  43.       out   dx, al
  44.    End;
  45. End;
  46. {--------------------------------------------------------------------------}
  47. Procedure GetPal(Col : Byte; Var R, G, B : Byte);
  48. Var
  49.    Rt,Gt,Bt : Byte;
  50. Begin
  51.    Asm
  52.       mov   dx, 3c7h
  53.       mov   al, [Col]
  54.       out   dx, al
  55.       inc   dx
  56.       inc   dx
  57.       in    al, dx
  58.       mov   [Rt],al
  59.       in    al, dx
  60.       mov   [Gt],al
  61.       in    al, dx
  62.       mov   [Bt],al
  63.    End;
  64.    R := Rt;
  65.    G := Gt;
  66.    B := Bt;
  67. End;
  68. {----------------------------------------------------------------------------}
  69. Procedure UpdPalette(Pallt:PalT);
  70. Var  AA:Word;
  71. Begin
  72.  For AA:=0 to 255 do pal(AA,Pallt[AA,0],Pallt[AA,1],Pallt[AA,2]);
  73. End;
  74. {----------------------------------------------------------------------------}
  75. Procedure CheckVga;
  76. Var ok:byte;
  77. begin
  78.  asm;
  79.      mov ah,1ah
  80.      mov al,0
  81.      int 10h
  82.      mov ok,al
  83.  end;
  84.  if ok<>$1a then
  85.      begin
  86.           VideoMode($3);
  87.           clrscr;
  88.            Writeln('VGA Card not found. Aborting...');
  89.           halt(255);
  90.      end;
  91. end;
  92. {----------------------------------------------------------------------------}
  93. Procedure SetupStars;
  94. Var i:Byte;
  95.     j:Integer;
  96.     x:integer;
  97.     y:byte;
  98. Begin
  99.     For i:=1 to Maxlayers do
  100.         for j:=1 to maxstars do
  101.         Begin
  102.         x:=random(320);
  103.             y:=random(200);
  104.             stars[i][j][0]:=x;
  105.             stars[i][j][1]:=y;
  106.         End;
  107. End;
  108. {---------------------------------------------------------------------------}
  109. Procedure SetUpPallete;
  110. Var i : 0..2;
  111. Begin
  112. for i:=0 to 2 do
  113.     Pallete[1][i]:=63;
  114. for i:=0 to 2 do
  115.     Pallete[2][i]:=40;
  116. for i:=0 to 2 do
  117.     Pallete[3][i]:=30;
  118. for i:=0 to 2 do
  119.     Pallete[4][i]:=20;
  120. end;
  121. {-------------------------------------------------------------------------}
  122. procedure WaitRetrace;
  123. begin
  124.   repeat until (Port[$03da] and 8) <> 0;
  125. end;
  126. {-------------------------------------------------------------------------}
  127. procedure WaitNotRetrace;
  128. begin
  129.   repeat until (Port[$03da] and 8) <> 8;
  130. end;
  131. {-------------------------------------------------------------------------}
  132. Procedure UpDateScreen;
  133. var i,j:integer;
  134. Begin
  135.     For i:=1 to maxlayers do
  136.         for j:=1 to maxstars do
  137.         begin
  138.          PutPixel(stars[i][j][0],stars[i][j][1],i,vgaaddr);
  139.     end;
  140. end;
  141. {----------------------------------------------------------------------------}
  142. Procedure DeleteOldStuff;
  143. var i,j:integer;
  144. Begin
  145.      For i:=1 to maxlayers do
  146.         for j:=1 to maxstars do
  147.          begin
  148.          PutPixel(stars[i][j][0],stars[i][j][1],0,vgaaddr);
  149.     end;
  150. end;
  151. (****************************-=■Main■=-**************************************)
  152. Begin
  153.     Randomize;
  154.     CheckVga;
  155.     Videomode($13);
  156.     setuppallete;
  157.     updpalette(pallete);
  158.     setupstars;
  159.     Ticks:=0;
  160.     Repeat
  161.         waitretrace;
  162.         DeleteOldStuff;
  163.            inc(ticks);
  164.             For i:=1 to maxstars do
  165.                 if (stars[1][i][0]<>319) then
  166.             Inc(stars[1][i][0])
  167.                 else
  168.                      stars[1][i][0]:=0;
  169.                 {if (stars[1][i][1]<>199) then
  170.             Inc(stars[1][i][1])
  171.                 else
  172.                      stars[1][i][1]:=0;}
  173.         if (ticks mod maxlayers)<3 then
  174.              For i:=1 to maxstars do
  175.                 if (stars[2][i][0]<>319) then
  176.             Inc(stars[2][i][0])
  177.                 else
  178.                      stars[2][i][0]:=0;
  179.                 {if (stars[2][i][1]<>199) then
  180.             Inc(stars[2][i][1])
  181.                 else
  182.                      stars[2][i][1]:=0;}
  183.         if (ticks mod maxlayers)<2 then
  184.              For i:=1 to maxstars do
  185.                 if (stars[3][i][0]<>319) then
  186.             Inc(stars[3][i][0])
  187.                 else
  188.                      stars[3][i][0]:=0;
  189.                 {if (stars[3][i][1]<>199) then
  190.             Inc(stars[3][i][1])
  191.                 else
  192.                      stars[3][i][1]:=0;}
  193.         if (ticks mod maxlayers)<1 then
  194.              For i:=1 to maxstars do
  195.                 if (stars[4][i][0]<>319) then
  196.             Inc(stars[4][i][0])
  197.                 else
  198.                      stars[4][i][0]:=0;
  199.                 {if (stars[4][i][1]<>199) then
  200.             Inc(stars[4][i][1])
  201.                 else
  202.                      stars[4][i][1]:=0;}
  203.         updatescreen;
  204.         if ticks=65535 then
  205.        ticks:=0;
  206.         if keypressed then ch:=readkey;
  207.     until ch=#27;
  208.     Videomode($3);
  209.     writeln('Coded by ScorpioS / ACG ''95. Rip ''n'' die.');
  210. End.
  211.